home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / dev / lang / fpcsrc.lha / fpc / compiler / assemble.pas < prev    next >
Pascal/Delphi Source File  |  1998-09-24  |  12KB  |  503 lines
  1. {
  2.     $Id: assemble.pas,v 1.1.1.1.2.2 1998/08/13 13:33:16 carl Exp $
  3.     Copyright (c) 1998 by the FPC development team
  4.  
  5.     This unit handles the assemblerfile write and assembler calls of FPC
  6.  
  7.     This program is free software; you can redistribute it and/or modify
  8.     it under the terms of the GNU General Public License as published by
  9.     the Free Software Foundation; either version 2 of the License, or
  10.     (at your option) any later version.
  11.  
  12.     This program is distributed in the hope that it will be useful,
  13.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  14.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15.     GNU General Public License for more details.
  16.  
  17.     You should have received a copy of the GNU General Public License
  18.     along with this program; if not, write to the Free Software
  19.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21.  ****************************************************************************}
  22.  
  23. unit assemble;
  24.  
  25. interface
  26.  
  27. uses
  28.   dos,cobjects,globals,aasm;
  29.  
  30. const
  31. {$ifdef tp}
  32.   AsmOutSize=1024;
  33. {$else}
  34.   AsmOutSize=10000;
  35. {$endif}
  36.  
  37.  
  38. {$ifdef i386}
  39. { tof = (of_none,of_o,of_obj,of_masm,of_att,of_nasm,of_win32) }
  40.   AsBin : array[tof] of string[8]=('','as','nasm','masm','as','nasm','asw');
  41. {$endif}
  42. {$ifdef m68k}
  43. { tof = (of_none,of_o,of_gas,of_mot,of_mit) }
  44.   AsBin : array[tof] of string[8]=('','amigaas','amigaas','','amigaas');
  45. {$endif}
  46.  
  47.  
  48. type
  49.   PAsmList=^TAsmList;
  50.   TAsmList=object
  51.     outcnt  : longint;
  52.     outbuf  : array[0..AsmOutSize-1] of char;
  53.     outfile : file;
  54.     constructor Init;
  55.     destructor Done;
  56.     Procedure AsmFlush;
  57.     Procedure AsmWrite(const s:string);
  58.     Procedure AsmWritePChar(p:pchar);
  59.     Procedure AsmWriteLn(const s:string);
  60.     Procedure AsmLn;
  61.     procedure OpenAsmList(const fn,fn2:string);
  62.     procedure CloseAsmList;
  63.     procedure WriteTree(p:paasmoutput);virtual;
  64.     procedure WriteAsmList;virtual;
  65.   end;
  66.  
  67.   PAsmFile=^TAsmFile;
  68.   TAsmFile=object
  69.     asmlist : pasmlist;
  70.     path:dirstr;
  71.     asmfile,
  72.     objfile,
  73.     srcfile,
  74.     as_bin  : string;
  75.     Constructor Init(const fn:string);
  76.     Destructor Done;
  77.     Function FindAssembler(curr_of:tof):string;
  78.     Procedure WriteAsmSource;
  79.     Function CallAssembler(const command,para:string):Boolean;
  80.     Procedure RemoveAsm;
  81.     Function DoAssemble:boolean;
  82.   end;
  83.  
  84. Implementation
  85.  
  86. uses
  87.   script,files,systems,verbose
  88. {$ifdef linux}
  89.   ,linux
  90. {$endif}
  91.   ,strings
  92. {$ifdef i386}
  93.   ,ag386att,ag386int
  94. {$endif}
  95. {$ifdef m68k}
  96.   ,ag68kmot,ag68kgas,ag68kmit
  97. {$endif}
  98.   ;
  99.  
  100.  
  101. Function DoPipe:boolean;
  102. begin
  103.   DoPipe:=use_pipe and (not writeasmfile) and (current_module^.output_format=of_o);
  104. end;
  105.  
  106.  
  107. {*****************************************************************************
  108.                                   TASMLIST
  109. *****************************************************************************}
  110.  
  111. Procedure TAsmList.AsmFlush;
  112. begin
  113.   if outcnt>0 then
  114.    begin
  115.      BlockWrite(outfile,outbuf,outcnt);
  116.      outcnt:=0;
  117.    end;
  118. end;
  119.  
  120.  
  121. Procedure TAsmList.AsmWrite(const s:string);
  122. begin
  123.   if OutCnt+length(s)>=AsmOutSize then
  124.    AsmFlush;
  125.   Move(s[1],OutBuf[OutCnt],length(s));
  126.   inc(OutCnt,length(s));
  127. end;
  128.  
  129.  
  130. Procedure TAsmList.AsmWriteLn(const s:string);
  131. begin
  132.   AsmWrite(s);
  133.   AsmWrite(target_info.newline);
  134. end;
  135.  
  136.  
  137. Procedure TAsmList.AsmWritePChar(p:pchar);
  138. var
  139.   i,j : longint;
  140. begin
  141.   i:=StrLen(p);
  142.   j:=i;
  143.   while j>0 do
  144.    begin
  145.      i:=min(j,AsmOutSize);
  146.      if OutCnt+i>=AsmOutSize then
  147.       AsmFlush;
  148.      Move(p[0],OutBuf[OutCnt],i);
  149.      inc(OutCnt,i);
  150.      dec(j,i);
  151.      p:=pchar(@p[i]);
  152.    end;
  153. end;
  154.  
  155.  
  156.  
  157.  
  158. Procedure TAsmList.AsmLn;
  159. begin
  160.   AsmWrite(target_info.newline);
  161. end;
  162.  
  163.  
  164. procedure TAsmList.OpenAsmList(const fn,fn2:string);
  165. begin
  166. {$ifdef linux}
  167.   if DoPipe then
  168.    begin
  169.      Message1(exec_i_assembling_pipe,fn);
  170.      POpen(outfile,'as -o '+fn2,'W');
  171.    end
  172.   else
  173. {$endif}
  174.    begin
  175.      Assign(outfile,fn);
  176.      {$I-}
  177.       Rewrite(outfile,1);
  178.      {$I+}
  179.      if ioresult<>0 then
  180.       Message1(exec_d_cant_create_asmfile,fn);
  181.    end;
  182.   outcnt:=0;
  183. end;
  184.  
  185.  
  186. procedure TAsmList.CloseAsmList;
  187. var
  188.   f : file;
  189.   l : longint;
  190. begin
  191.   AsmFlush;
  192. {$ifdef linux}
  193.   if DoPipe then
  194.    Close(outfile)
  195.   else
  196. {$endif}
  197.    begin
  198.    {Touch Assembler time to ppu time is there is a ppufilename}
  199.      if Assigned(current_module^.ppufilename) then
  200.       begin
  201.         Assign(f,current_module^.ppufilename^);
  202.         reset(f,1);
  203.         if ioresult=0 then
  204.          begin
  205.            getftime(f,l);
  206.            close(f);
  207.            reset(outfile,1);
  208.            setftime(outfile,l);
  209.          end;
  210.       end;
  211.      close(outfile);
  212.    end;
  213. end;
  214.  
  215.  
  216. procedure TAsmList.WriteTree(p:paasmoutput);
  217. begin
  218. end;
  219.  
  220.  
  221. procedure TAsmList.WriteAsmList;
  222. begin
  223. end;
  224.  
  225.  
  226. constructor TAsmList.Init;
  227. begin
  228.   OutCnt:=0;
  229. end;
  230.  
  231.  
  232. destructor TAsmList.Done;
  233. begin
  234. end;
  235.  
  236.  
  237. {*****************************************************************************
  238.                                   TASMFILE
  239. *****************************************************************************}
  240.  
  241. Constructor TAsmFile.Init(const fn:string);
  242. var
  243.   name:namestr;
  244.   ext:extstr;
  245. begin
  246. {Create filenames for easier access}
  247.   fsplit(fn,path,name,ext);
  248.   srcfile:=fn;
  249.   asmfile:=path+name+target_info.asmext;
  250.   objfile:=path+name+target_info.objext;
  251. {Init output format}
  252.   case current_module^.output_format of
  253. {$ifdef i386}
  254.      of_o,
  255.      of_win32,
  256.      of_att:
  257.        asmlist:=new(pi386attasmlist,Init);
  258.      of_obj,
  259.      of_masm,
  260.      of_nasm:
  261.        asmlist:=new(pi386intasmlist,Init);
  262. {$endif}
  263. {$ifdef m68k}
  264.    of_o,
  265.    of_gas : asmlist:=new(pm68kgasasmlist,Init);
  266.    of_mot : asmlist:=new(pm68kmotasmlist,Init);
  267.    of_mit : asmlist:=new(pm68kmitasmlist,Init);
  268. {$endif}
  269.   else
  270.    internalerror(30000);
  271.   end;
  272. end;
  273.  
  274.  
  275. Destructor TAsmFile.Done;
  276. begin
  277. end;
  278.  
  279.  
  280. Procedure TAsmFile.WriteAsmSource;
  281. begin
  282.   asmlist^.OpenAsmList(asmfile,objfile);
  283.   asmlist^.WriteAsmList;
  284.   asmlist^.CloseAsmList;
  285. end;
  286.  
  287.  
  288. const
  289.   last_of  : tof=of_none;
  290. var
  291.   LastASBin : string;
  292. Function TAsmFile.FindAssembler(curr_of:tof):string;
  293. var
  294.   asfound : boolean;
  295. begin
  296.   if last_of<>curr_of then
  297.    begin
  298.      last_of:=curr_of;
  299.      LastASBin:=FindExe(asbin[curr_of],asfound);
  300.      if (not asfound) and (not externasm) then
  301.       begin
  302.         Message1(exec_w_assembler_not_found,LastASBin);
  303.         externasm:=true;
  304.       end;
  305.      if asfound then
  306.       Message1(exec_u_using_assembler,LastASBin);
  307.    end;
  308.   FindAssembler:=LastASBin;
  309. end;
  310.  
  311.  
  312. Function TAsmFile.CallAssembler(const command,para:string):Boolean;
  313. begin
  314.   if not externasm then
  315.    begin
  316.      swapvectors;
  317.      exec(command,para);
  318.      swapvectors;
  319.      if (dosexitcode<>0) then
  320.       begin
  321.         Message(exec_w_error_while_assembling);
  322.         callassembler:=false;
  323.         exit;
  324.       end
  325.      else
  326.       if (doserror<>0) then
  327.        begin
  328.          Message(exec_w_cant_call_assembler);
  329.          externasm:=true;
  330.        end;
  331.    end;
  332.   if externasm then
  333.    AsmRes.AddAsmCommand(command,para,asmfile);
  334.   callassembler:=true;
  335. end;
  336.  
  337.  
  338. procedure TAsmFile.RemoveAsm;
  339. var
  340.   g : file;
  341.   i : word;
  342. begin
  343.   if writeasmfile then
  344.    exit;
  345.   if ExternAsm then
  346.    AsmRes.AddDeleteCommand (AsmFile)
  347.   else
  348.    begin
  349.      assign(g,asmfile);
  350.      {$I-}
  351.       erase(g);
  352.      {$I+}
  353.      i:=ioresult;
  354.    end;
  355. end;
  356.  
  357.  
  358. Function TAsmFile.DoAssemble:boolean;
  359. begin
  360.   if DoPipe then
  361.    exit;
  362.   if not externasm then
  363.    Message1(exec_i_assembling,asmfile);
  364.   case current_module^.output_format of
  365. {$ifdef i386}
  366.    of_att : begin
  367.               externasm:=true; {Force Extern Asm}
  368.               if CallAssembler(FindAssembler(of_att),' -D -o '+objfile+' '+asmfile) then
  369.                RemoveAsm;
  370.             end;
  371.      of_o : begin
  372.               if CallAssembler(FindAssembler(of_o),'-D -o '+objfile+' '+asmfile) then
  373.                RemoveAsm;
  374.             end;
  375.  of_win32 : begin
  376.               if CallAssembler(FindAssembler(of_win32),'-D -o '+objfile+' '+asmfile) then
  377.                RemoveAsm;
  378.             end;
  379.   of_nasm : begin
  380.             {$ifdef linux}
  381.               if CallAssembler(FindAssembler(of_nasm),' -f elf -o '+objfile+' '+asmfile) then
  382.                RemoveAsm;
  383.             {$else}
  384.               if CallAssembler(FindAssembler(of_nasm),' -f coff -o '+objfile+' '+asmfile)